home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / Moscow ML 1.31 / source code / mosml / src / mosmllib / Real.sml < prev    next >
Encoding:
Text File  |  1996-07-03  |  4.7 KB  |  160 lines  |  [TEXT/R*ch]
  1. (* Real.sml -- 1995-05-24 *)
  2.  
  3. type real = real
  4.  
  5. exception Div = Div
  6. and Overflow = Overflow;
  7.  
  8. fun ceil r = ~(floor (~r));
  9. val floor   = floor;
  10. fun trunc r = if r >= 0.0 then floor r else ceil r;
  11.  
  12. (* The following is rather inefficient, but correct.  A faster method
  13.    exists, see src/sml-nj/boot/math.sml, but that does not work on a
  14.    number such as 1000001.4999, which gets rounded to 1000002.0 (but only on 
  15.    an x86 computing with extended precision). *)
  16.  
  17. fun round r = 
  18.     let prim_val andb_ : int -> int -> int = 2 "and";
  19.     val rf = floor r
  20.     val df = r - real rf 
  21.     in 
  22.     if df > 0.5 orelse df = 0.5 andalso andb_ 1 rf = 1 then rf + 1 
  23.     else rf 
  24.     end
  25.  
  26. val real = real;
  27.  
  28. (* The following should be replaced by numerically better conversion
  29. functions; see 
  30.  
  31. Steele and White : How to print floating-point numbers accurately,
  32. PLDI'90, pages 112-123, and
  33.  
  34. Clinger: How to read floating-point numbers accurately, PLDI'90, pages
  35. 92-101.
  36.  
  37. D.M. Gay: Correctly rounded binary-decimal and decimal-binary
  38. conversions, AT&T Bell Labs, Numerical Analysis Manuscript 90-10,
  39. November 30, 1990 *)
  40.  
  41. fun fmt spec r = 
  42.     let prim_val to_string : string -> real -> string 
  43.                          = 2 "sml_general_string_of_float";
  44.     fun fracdigs NONE     = "%" 
  45.       | fracdigs (SOME n) = "%." ^ makestring (if n < 0 then 0 else n)
  46.     open StringCvt
  47.     val cfmtspec = 
  48.         case spec of
  49.         SCI arg  => fracdigs arg ^ "e"
  50.           | FIX arg  => fracdigs arg ^ "f"
  51.           | GEN NONE => "%.12g"
  52.           | GEN arg  => fracdigs arg ^ "g"
  53.     in to_string cfmtspec r end
  54.  
  55. fun toString r = fmt (StringCvt.GEN NONE) r;
  56.  
  57. fun scan {getc} source = 
  58.     let fun decval c = Char.ord c - 48
  59.     fun pow10 0 = 1.0
  60.       | pow10 n = 
  61.         if n rem 2 = 0 then 
  62.         let val x = pow10 (n quot 2) in x * x end
  63.         else 10.0 * pow10 (n-1)
  64.     fun pointsym src = 
  65.         case getc src of
  66.         NONE           => (false, src)
  67.           | SOME (c, rest) => if c = #"." then (true, rest)
  68.                   else (false, src)
  69.     fun esym src = 
  70.         case getc src of
  71.         NONE           => (false, src)
  72.           | SOME (c, rest) => 
  73.             if c = #"e" orelse c = #"E"  then 
  74.             (true, rest)
  75.             else (false, src)
  76.     fun scandigs first next final source =
  77.         let fun digs state src = 
  78.         case getc src of
  79.             NONE          => (SOME (final state), src)
  80.           | SOME(c, rest) => 
  81.             if Char.isDigit c then 
  82.                 digs (next(state, decval c)) rest
  83.             else 
  84.                 (SOME (final state), src)
  85.         in 
  86.         case getc source of
  87.             NONE          => (NONE, source)
  88.           | SOME(c, rest) => 
  89.             if Char.isDigit c then digs (first (decval c)) rest
  90.             else (NONE, source)
  91.         end
  92.  
  93.     fun ident x = x
  94.     val getint  = 
  95.         scandigs real (fn (res, cval) => 10.0 * res + real cval) ident
  96.     val getfrac = 
  97.         scandigs (fn cval => (1, real cval))    
  98.                  (fn ((decs, frac), cval) => (decs+1, 10.0*frac+real cval))
  99.              (fn (decs, frac) => frac / pow10 decs)
  100.     val getexp = scandigs ident (fn (res, cval) => 10 * res + cval) ident
  101.  
  102.     fun sign src =
  103.         case getc src of
  104.         SOME(#"+", rest) => (true,  rest)
  105.           | SOME(#"-", rest) => (false, rest)
  106.           | SOME(#"~", rest) => (false, rest)
  107.           | _                => (true,  src )
  108.  
  109.     val src = StringCvt.skipWS {getc=getc} source
  110.     val (manpos, src)  = sign src
  111.     val (intg,   src)  = getint src
  112.     val (decpt,  src)  = pointsym src
  113.     val (frac,   src)  = getfrac src 
  114.     val (esym,   src)  = esym src
  115.     val (exppos, src)  = sign src
  116.     val (expv,   rest) = getexp src
  117.  
  118.         fun mkres manval = 
  119.         let val res = if manpos then manval else ~manval
  120.         in 
  121.         case (esym, expv) of
  122.             (false, NONE    ) => SOME(res, rest)
  123.           | (true,  SOME exp) => 
  124.             if exppos then SOME(res * pow10 exp, rest)
  125.             else SOME(res / pow10 exp, rest)
  126.           | _                 => NONE
  127.         end
  128.     in 
  129.     case (intg, decpt, frac) of
  130.         (NONE,      true,  SOME fval) => mkres fval
  131.           | (SOME ival, false, SOME _   ) => NONE
  132.           | (SOME ival, _    , NONE     ) => mkres ival
  133.           | (SOME ival, _    , SOME fval) => mkres (ival+fval)
  134.       | _                             => NONE 
  135.     end;
  136.  
  137. val fromString = StringCvt.scanString scan;
  138.  
  139. val ~       : real -> real        = ~;
  140. val op +    : real * real -> real = op +;
  141. val op -    : real * real -> real = op -;
  142. val op *    : real * real -> real = op *;
  143. val op /    : real * real -> real = op /;
  144. val op >    : real * real -> bool = op >;
  145. val op >=   : real * real -> bool = op >=;
  146. val op <    : real * real -> bool = op <;
  147. val op <=   : real * real -> bool = op <=;
  148. val abs     : real -> real = abs;
  149. fun sign i = if i > 0.0 then 1 else if i < 0.0 then ~1 else 0;
  150. fun compare (x, y: real) = 
  151.     if x<y then LESS else if x>y then GREATER else EQUAL;
  152.  
  153. fun sameSign (i, j) = sign i = sign j;
  154.  
  155. fun min (x, y) = if x < y then x else y : real;
  156. fun max (x, y) = if x < y then y else x : real;
  157.  
  158. fun toDefault   i   = i;
  159. fun fromDefault i   = i;
  160.